perm filename CYCDRJ[DEN,LMM] blob sn#034884 filedate 1973-04-13 generic text, type T, neo UTF8

(DEFPROP CYCDRJFNS
 (CYCDRJFNS ISOMERS RING DRAW LABELLER)
VALUE)

(DEFPROP ISOMERS
 (LAMBDA NIL
  (PROG	(CL U)
   CLLP	(PRINT (QUOTE CL?))
	(SETQ CL (READ))
	(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
	(COND
	 ((PROG	(FOR-VALUE LIST*PR PR)
		(SETQ LIST*PR CL)
	   LOOP*1
		(COND ((NOT LIST*PR) (GO RETURN)))
		(SETQ PR (CAR LIST*PR))
		(COND
		 ((SETQ	FOR-VALUE
			(OR (ATOM PR)
			    (NOT (NUMBERP (CDR PR)))
			    (NOT (ATOM (CAR PR)))
			    (NOT
			     (OR (NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
				 (PROG2	(TERPRI)
					(PRINC (QUOTE "WHAT'S THE VALENCE OF "))
					(PRINC (CAR PR))
					(PRINC (QUOTE ?))
					(NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
		  (RETURN FOR-VALUE)))
	   NEXT*1
	   NEXT*PR
		(SETQ LIST*PR (CDR LIST*PR))
		(GO LOOP*1)
	   RETURN
		(RETURN FOR-VALUE))
	  (GO CLLP)))
   ULP	(PRINT (QUOTE U?))
	(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
	(SETQ RESULTS (MOLECULES CL U))
	(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)

(DEFPROP RING
 (LAMBDA NIL
  (PROG	(CL U)
   CLLP	(PRINT (QUOTE CL?))
	(SETQ CL (READ))
	(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
	(COND
	 ((FOR NEW
	       PR
	       IN
	       CL
	       OR
	       (OR (ATOM PR)
		   (NOT (NUMBERP (CDR PR)))
		   (NOT (ATOM (CAR PR)))
		   (NOT
		    (OR	(NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
			(PROG2 (TERPRI)
			       (PRINC (QUOTE "WHAT'S THE VALENCE OF "))
			       (PRINC (CAR PR))
			       (PRINC (QUOTE ?))
			       (NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
	  (GO CLLP)))
   ULP	(PRINT (QUOTE U?))
	(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
	(SETQ RESULTS (RINGS U CL))
	(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)

(DEFPROP DRAW
 (LAMBDA(N)
  (PROG	(S)
	(COND ((GREATERP N (LENGTH RESULTS)) (PRINT (QUOTE (NOT THAT MANY STRUCTURES -- TRY AGAIN!!!))))
	      ((STRUCTURE? (SETQ S (CAR (NTH RESULTS N)))) (DRAWS S NIL))
	      (T (SETQ TITLE (LIST (QUOTE STRUCTURE#) N)) (PRINRAD S)))))
EXPR)

(DEFPROP LABELLER
 (LAMBDA NIL
  (PROG	(CL U)
   CLLP	(TERPRI)
	(PRINC (QUOTE "ATOMS TO BE LABELLED?"))
	(SETQ CL (READ))
	(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
	(COND
	 ((FOR NEW
	       PR
	       IN
	       CL
	       OR
	       (OR (ATOM PR)
		   (NOT (NUMBERP (CDR PR)))
		   (NOT (ATOM (CAR PR)))
		   (NOT
		    (OR	(NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
			(PROG2 (TERPRI)
			       (PRINC (QUOTE "WHAT'S THE VALENCE OF "))
			       (PRINC (CAR PR))
			       (PRINC (QUOTE ?))
			       (NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
	  (GO CLLP)))
   ULP	(PRINT (QUOTE U?))
	(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
	(SETQ RESULTS (MOLECULES CL U))
	(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)